home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
ffspas.zip
/
DEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
30KB
|
759 lines
PROGRAM democolor;
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ - COLOR & CALC - }
{--------------------------------------------------------------------------}
{ Version 1.0 02/01/90 }
{--------------------------------------------------------------------------}
{ The TPU source code as shareware is available from: }
{ }
{ The Final Frontier BBS }
{ 1200, 2400, 9600 Baud }
{ (518) 761-0869 }
{--------------------------------------------------------------------------}
{ Written By : William W. Miller, Jr. Final Frontier Software }
{ 524 Rock Avenue All rights reserved }
{ Chestertown, NY 12817 }
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
USES
globals, crt, dos, fastttt5, winttt5, keyttt5, strnttt5,
nestttt5, iottt5, miscttt5, readttt5, dirttt5, color55,
calc55;
{ Note : variables defined in GLOBALS.PAS/TPU }
{ Program works with mouse OR keyboard }
CONST
timedelay : INTEGER = 8000;
VAR
foreground : INTEGER;
background : INTEGER;
PROCEDURE setup_menus;
BEGIN
initialize_menu(mainmenu, ' COLOR Demo ', 0, 0);
initialize_menu(filemenu, ' File Management Menu ', 0, 0);
initialize_menu(windowmenu, ' Windows Management Menu ', 0, 0);
initialize_menu(blockmenu, ' Block Menu ', 0, 0);
initialize_menu(searchmenu, ' Search Document Menu ', 0, 0);
initialize_menu(editmenu, ' Edit Document Menu ', 0, 0);
initialize_menu(optionsmenu, ' Options Menu ', 0, 0);
initialize_menu(printmenu, ' Print Document Menu ', 0, 0);
initialize_menu(macromenu, ' Macro Menu ', 0, 0);
initialize_menu(colormenu, ' Colors Menu ', 0, 0);
initialize_menu(nestcolor, ' Nested Menu Color ', 0, 0);
initialize_menu(dircolor, ' Directory Manager Colors ', 0, 0);
initialize_menu(filemrgmenu, ' File Manager ', 0, 0);
END;
PROCEDURE define_mainmenu;
BEGIN
add_topic(mainmenu, ' File Management Menu ', TRUE, #0, 0, @filemenu);
add_topic(mainmenu, ' Windows Management Menu ', TRUE, #0, 0, @windowmenu);
add_topic(mainmenu, ' Block Menu ', TRUE, #0, 0, @blockmenu);
add_topic(mainmenu, ' Search Document Menu ', TRUE, #0, 0, @searchmenu);
add_topic(mainmenu, ' Edit Document Menu ', TRUE, #0, 0, @editmenu);
add_topic(mainmenu, ' Options Menu ', TRUE, #0, 0, @optionsmenu);
add_topic(mainmenu, ' Print Document Menu ', TRUE, #0, 0, @printmenu);
add_topic(mainmenu, ' Macros Menu', TRUE, #0, 0, @macromenu);
add_topic(mainmenu, '-', FALSE, #0, 0, NIL);
add_topic(mainmenu, ' Colors Menu Alt-C', TRUE, #174, 0, @colormenu);
add_topic(mainmenu, '-', FALSE, #0, 0, NIL);
add_topic(mainmenu, ' cAlendar', TRUE, #0, 807, NIL);
add_topic(mainmenu, ' calcUlator Alt-U', TRUE, #150, 1500, NIL);
add_topic(mainmenu, ' Return Alt-R', TRUE, #147, 116, NIL);
add_topic(mainmenu, ' Quit Alt-X', TRUE, #173, 999, NIL);
END;
PROCEDURE define_filemenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(filemenu, 'File Manager', TRUE, #0, 0, @filemrgmenu);
add_topic(filemenu, 'Load', TRUE, #0, 0, NIL);
add_topic(filemenu, 'Save', TRUE, #0, 0, NIL);
add_topic(filemenu, 'Read', TRUE, #0, 0, NIL);
add_topic(filemenu, 'Change Name', FALSE, #0, 0, NIL);
add_topic(filemenu, 'Write Block', FALSE, #0, 0, NIL);
add_topic(filemenu, 'OS Shell', FALSE, #0, 0, NIL);
add_topic(filemenu, 'Global', FALSE, #0, 0, NIL);
add_topic(filemenu, '-', FALSE, #0, 0, NIL);
add_topic(filemenu, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_windowmenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(windowmenu, 'Close', TRUE, #0, 0, NIL);
add_topic(windowmenu, 'Grow', TRUE, #0, 0, NIL);
add_topic(windowmenu, 'Split', TRUE, #0, 0, NIL);
add_topic(windowmenu, 'Next', FALSE, #0, 0, NIL);
add_topic(windowmenu, 'Previous', FALSE, #0, 0, NIL);
add_topic(windowmenu, 'Shrink', FALSE, #0, 0, NIL);
add_topic(windowmenu, 'Zoom', FALSE, #0, 0, NIL);
add_topic(windowmenu, '-', FALSE, #0, 0, NIL);
add_topic(windowmenu, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_blockmenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(blockmenu, 'mark block Begin', TRUE, #0, 0, NIL);
add_topic(blockmenu, 'mark block End', TRUE, #0, 0, NIL);
add_topic(blockmenu, 'Copy Block', TRUE, #0, 0, NIL);
add_topic(blockmenu, 'Move Block', TRUE, #0, 0, NIL);
add_topic(blockmenu, 'Delete Block', FALSE, #0, 0, NIL);
add_topic(blockmenu, 'Unmark Block', FALSE, #0, 0, NIL);
add_topic(blockmenu, 'Mark Line', TRUE, #0, 0, NIL);
add_topic(blockmenu, '-', FALSE, #0, 0, NIL);
add_topic(blockmenu, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_searchmenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(searchmenu, 'Find', TRUE, #0, 0, NIL);
add_topic(searchmenu, 'Replace', TRUE, #0, 0, NIL);
add_topic(searchmenu, 'Search Again', TRUE, #0, 0, NIL);
add_topic(searchmenu, '-', FALSE, #0, 0, NIL);
add_topic(searchmenu, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_editmenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(editmenu, 'Add Line', TRUE, #0, 0, NIL);
add_topic(editmenu, 'Delete Line', TRUE, #0, 0, NIL);
add_topic(editmenu, 'delete to End of Line', TRUE, #0, 0, NIL);
add_topic(editmenu, 'Insert Line', TRUE, #0, 0, NIL);
add_topic(editmenu, 'Join Line', FALSE, #0, 0, NIL);
add_topic(editmenu, 'Split Line', TRUE, #0, 0, NIL);
add_topic(editmenu, 'Undelete Line', TRUE, #0, 0, NIL);
add_topic(editmenu, '-', FALSE, #0, 0, NIL);
add_topic(editmenu, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_optionsmenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(optionsmenu, 'set Auto Indent Off', TRUE, #0, 0, NIL);
add_topic(optionsmenu, 'set Insert Off', TRUE, #0, 0, NIL);
add_topic(optionsmenu, 'set Work Wrap Off', TRUE, #0, 0, NIL);
add_topic(optionsmenu, 'set Print Tab Width', TRUE, #0, 0, NIL);
add_topic(optionsmenu, 'set Center Tab', FALSE, #0, 0, NIL);
add_topic(optionsmenu, 'set Left Margin', TRUE, #0, 0, NIL);
add_topic(optionsmenu, 'set right Margin', TRUE, #0, 0, NIL);
add_topic(optionsmenu, 'set BackUps Off', TRUE, #0, 0, NIL);
add_topic(optionsmenu, 'set Default Colors', TRUE, #0, 0, NIL);
add_topic(optionsmenu, '-', FALSE, #0, 0, NIL);
add_topic(optionsmenu, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_printmenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(printmenu, 'print All', TRUE, #0, 0, NIL);
add_topic(printmenu, 'print Block', TRUE, #0, 0, NIL);
add_topic(printmenu, 'print Line', TRUE, #0, 0, NIL);
add_topic(printmenu, 'Form Feed', TRUE, #0, 0, NIL);
add_topic(printmenu, 'set Page Size', FALSE, #0, 0, NIL);
add_topic(printmenu, 'Initialize Printer', TRUE, #0, 0, NIL);
add_topic(printmenu, '-', FALSE, #0, 0, NIL);
add_topic(printmenu, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_macromenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(macromenu, 'Macro Record', TRUE, #0, 0, NIL);
add_topic(macromenu, 'Read Macro', TRUE, #0, 0, NIL);
add_topic(macromenu, 'Write Macro', TRUE, #0, 0, NIL);
add_topic(macromenu, '-', FALSE, #0, 0, NIL);
add_topic(macromenu, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_colormenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(colormenu, 'Main Screen Colors', TRUE, #0, 801, NIL);
add_topic(colormenu, 'Ruler Color', TRUE, #0, 312, NIL);
add_topic(colormenu, 'Menu Colors', TRUE, #0, 0, @nestcolor); {Nest Colors}
add_topic(colormenu, 'Directory Colors', TRUE, #0, 314, @dircolor);
add_topic(colormenu, 'Input Screen Colors', TRUE, #0, 313, NIL);
add_topic(colormenu, 'Display Screen Colors', TRUE, #0, 314, NIL);
add_topic(colormenu, '-', FALSE, #0, 0, NIL);
add_topic(colormenu, 'ESC-Return', TRUE, #27, 116, NIL);
add_topic(colormenu, 'Quit', TRUE, #173, 999, NIL);
END;
PROCEDURE define_nestcolor;
BEGIN
nttt.allowesc := TRUE;
add_topic(nestcolor, 'main Screen', TRUE, #0, 801, NIL);
add_topic(nestcolor, 'menu Box', TRUE, #0, 802, NIL);
add_topic(nestcolor, 'First Capital Letter', TRUE, #0, 803, NIL);
add_topic(nestcolor, 'Normal Menu Topics', TRUE, #0, 804, NIL);
add_topic(nestcolor, 'Selected Menu Topics', TRUE, #0, 805, NIL);
add_topic(nestcolor, 'Non-Selected Menu Topics', TRUE, #0, 806, NIL);
add_topic(nestcolor, '-', FALSE, #0, 0, NIL);
add_topic(nestcolor, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_dircolor;
BEGIN
nttt.allowesc := TRUE;
add_topic(dircolor, 'main Screen', TRUE, #0, 901, NIL);
add_topic(dircolor, 'Frame Color', TRUE, #0, 902, NIL);
add_topic(dircolor, 'Special Keys Color', TRUE, #0, 903, NIL);
add_topic(dircolor, 'Main Background Color', TRUE, #0, 904, NIL);
add_topic(dircolor, 'Normal Files Color', TRUE, #0, 905, NIL);
add_topic(dircolor, 'Directory Files', TRUE, #0, 906, NIL);
add_topic(dircolor, 'Selected File Color', TRUE, #0, 907, NIL);
add_topic(dircolor, '-', FALSE, #0, 0, NIL);
add_topic(dircolor, 'ESC-Return', FALSE, #27, 0, NIL);
END;
PROCEDURE define_filemgrmenu;
BEGIN
nttt.allowesc := TRUE;
add_topic(filemrgmenu, 'File Manager', TRUE, #178, 1000, NIL);
add_topic(filemrgmenu, 'Print ', TRUE, #0, 0, NIL);
add_topic(filemrgmenu, 'Save ', TRUE, #0, 0, NIL);
add_topic(filemrgmenu, 'Get ', TRUE, #0, 0, NIL);
add_topic(filemrgmenu, 'New ', TRUE, #0, 0, NIL);
add_topic(filemrgmenu, 'Form Feed ', TRUE, #0, 0, NIL);
add_topic(filemrgmenu, 'Authors ', TRUE, #0, 0, NIL);
add_topic(filemrgmenu, 'ESC-Return ', FALSE, #27, 0, NIL);
END;
{$F+}
PROCEDURE dummy;
BEGIN
END;
{$F-}
PROCEDURE false_calendar;
BEGIN
mkwin(10, 6, 50, 16, white, red, 2);
writebetween(11, 49, 8, white, red, 'SORRY');
writebetween(11, 49, 10, white, red, 'The Calendar procedure is');
writebetween(11, 49, 11, white, red, 'Not available with this');
writebetween(11, 49, 12, white, red, 'Release. Calendar may be');
writebetween(11, 49, 13, white, red, 'released with Version 2 of');
writebetween(11, 49, 14, white, red, 'the FFSPAS procedures.');
ch := getkey;
rmwin;
END;
{$F+}
PROCEDURE help_editkeys(VAR ch : CHAR; VAR fieldid : BYTE; VAR refresh : BYTE);
VAR c1, c2, c3 : BYTE;
BEGIN
IF colorscreen THEN
BEGIN
c1 := lightcyan; c2 := white; c3 := black;
END
ELSE
BEGIN
c1 := white; c2 := black; c3 := lightgray;
END;
allow_esc(FALSE);
allow_beep(TRUE);
IF ch <> #187 THEN
BEGIN
oncursor;
EXIT;
END;
offcursor;
mkwin(1, 1, 40, 25, c1, c3, 2);
writebetween(1, 40, 2, c2, c3, 'Editing Keys');
horizline(2, 39, 3, c1, c3, 1);
writeat(3, 5, c2, c3, 'Move Up ' + CHR(024));
writeat(3, 6, c2, c3, 'Move Down ' + CHR(025));
writeat(3, 7, c2, c3, 'Move Right Ctrl -' + CHR(016) + ', Tab or Enter');
writeat(3, 8, c2, c3, 'Move Left Ctrl ' + CHR(017) + '- or ShiftTab');
writeat(3, 9, c2, c3, 'End of line Press [End]');
writeat(3, 10, c2, c3, 'Insert Press [Ins] to toggle');
writeat(3, 11, c2, c3, 'Del Char [Del] or [Backspace]');
writeat(3, 12, c2, c3, 'Del Field Alt-D');
writeat(3, 13, c2, c3, 'Del Global Alt-E');
writeat(3, 14, c2, c3, 'Update (End Editing) F10');
writeat(3, 15, c2, c3, 'Abort [Esc] [Mouse Button]');
writeat(3, 17, c2, c3, 'Move between fields by moving the');
writeat(3, 18, c2, c3, 'mouse. The left button emulates');
writeat(3, 19, c2, c3, 'the Enter key and the right button');
writeat(3, 20, c2, c3, 'the ESC key');
horizline(2, 39, 22, c1, c3, 2);
writeat(3, 23, c2, c3, 'Press ESC or a Mouse Button to,');
writeat(3, 24, c2, c3, 'return to the input screen.');
REPEAT
ch := getkey;
UNTIL (ch = #027) OR (ch = #131) OR (ch = #132) OR (ch = #133);
ch := #0;
oncursor;
rmwin;
END;
{$F-}
{$F+}
PROCEDURE special_ins_hook(INSERT : BOOLEAN);
BEGIN
IF INSERT THEN
BEGIN
fullcursor;
writeat(57, 24, white, blue, 'INSERT');
END;
IF (NOT INSERT) THEN
BEGIN
sizecursor(scantop, scanbot);
writeat(57, 24, white, blue, ' ');
END;
END;
{$F-}
{$F+}
PROCEDURE paint_screen;
{makes the screen look like a word processor}
BEGIN
fbox(1, 1, 80, 25, foreground, background, 1); {<=== changed from MKWIN to prevent large # open windows 11/14}
writeat(1, 25, rulerfcolor, rulerbcolor,
padleft(' /- Main Menu AltC- Color Menu AltU- Calculator Alt-X to Quit Ver 1.0', 80, ' '));
writeat(1, 1, rulerfcolor, rulerbcolor,
'┬┬┬┬┼┬┬┬10┬┬┬┬┼┬┬┬20┬┬┬┬┼┬┬┬30┬┬┬┬┼┬┬┬40┬┬┬┬┼┬┬┬50┬┬┬┬┼┬┬┬60┬┬┬┬┼┬┬┬70┬┬┬┬┼┬┬┬80');
plainwrite(5, 3, 'Imagine you have written a word processing program and you want to give');
plainwrite(5, 4, 'the program a full and powerful menu system complete with a calculator');
plainwrite(5, 5, 'and color support! NOW three FFSPAS pascal units add even more POWER to');
plainwrite(5, 6, 'to your programs with easy to use CALCULATOR, COLOR control menu, and');
plainwrite(5, 7, 'CALENDAR procedures.');
plainwrite(5, 9, 'COLOR is a PASCAL procedure that display''s a menu to change screen,');
plainwrite(5, 10, 'menu, or other unit default colors.');
plainwrite(5, 12, 'CALCULATOR is a procedure to pop-up a calculator from within your');
plainwrite(5, 13, 'pascal program with ONE line of code.');
plainwrite(5, 15, 'For starters, press the F10 key or the slash key, and roam around');
plainwrite(5, 16, 'the menu a little for a demonstration of two of the FFSPAS procedures.');
plainwrite(5, 18, 'COLOR55 and CALC55 TPU''s are compatible with version 5.5 of Turbo');
plainwrite(5, 19, 'Pascal.');
plainwrite(5, 21, 'PROCEDURE - Color(forecolorsel,backcolorsel,forecolor,backcolor)');
plainwrite(5, 22, 'PROCEDURE - Calculator;');
savescreen(1);
END; {of proc Paint_Screen}
{$F-}
PROCEDURE quit;
BEGIN
reset_startup_mode;
mkwin(1,1,80,8,white,blue,1);
writecenter(2, white, blue, 'FFSPAS Units');
writecenter(3, white, blue, '(c) Copyright 1990 Final Frontier Software');
writecenter(4, white, blue, 'William W. Miller, Jr.');
writecenter(5, white, blue, '524 Rock Avenue, Chestertown, New York 12817');
writecenter(6, white, blue, 'Telephone (518) 494-4097');
writecenter(7, white, blue, 'Please Register Your Procedures at the Final Frontier BBS (518) 761-0869');
gotoxy(1, 9);
beep;
oncursor;
HALT(1);
END;
{$F+}
PROCEDURE menu_hook(VAR ch : CHAR; code : INTEGER);
BEGIN
delay(10);
savescreen(1);
CASE ch OF
#150 : BEGIN {ALT-U}
IF moused THEN cttt.delaytime := 100;
IF NOT moused THEN cttt.delaytime := 0;
cttt.points := 2;
calculator;
assign_idle_hook(dummy);
paint_screen;
show_nest(mainmenu);
END;
#173 : BEGIN {ALT-X}
reset_startup_mode;
HALT;
END;
#174 : BEGIN {ALT-C}
show_nest(colormenu); { BACKGROUND SCREEN VIA }
endprogram := FALSE; { HOT KEY }
END;
#27, #147 : BEGIN
restorescreen(1);
END;
END; {case}
END;
{$F-}
{$F+}
PROCEDURE menu_loop;
{THIS PROCEDURE CHECKS KEYPRESS AND MOUSE PRESS THEN TRANSFERS TO action}
{procedure FOR MENU SELECTION DETERMINATION}
VAR ch : CHAR;
BEGIN
endprogram := FALSE;
paint_screen;
delay(500);
assign_idle_hook(dummy);
REPEAT
ch := getkey;
CASE ch OF
#132, {Mouse ESC} { <== LEAVE MENUS }
#27 : BEGIN {ESC}
quit;
END;
#133, {Mouse Enter} { <== ENTER MENUS }
#47, {/}
#178, {ALT-M}
#196 : BEGIN ;
show_nest(mainmenu);
endprogram := FALSE; {F10}
END;
#173 : endprogram := TRUE; {ALT-X} { <== LEAVE Menu's }
#132,
#174 : BEGIN {ALT-C} { POPUP COLOR MENU FROM }
show_nest(colormenu); { BACKGROUND SCREEN VIA }
endprogram := FALSE; { HOT KEY }
END;
#150 : BEGIN {ALT-U} { POPUP CALCULATOR }
IF moused THEN cttt.delaytime := 100;
IF NOT moused THEN cttt.delaytime := 0;
cttt.points := 2;
calculator;
assign_idle_hook(dummy);
paint_screen;
END;
#147 : endprogram := FALSE;
END; {case}
UNTIL endprogram;
END;
{$F-} {end Menu_loop}
{$F+}
PROCEDURE action(VAR code : INTEGER; VAR finish : BYTE);
{THIS PROCEDURE CHECKS FOR MENU SELECTIONS}
VAR
dirf : STRING;
BEGIN
SaveScreen(1);
CASE code OF
116 : BEGIN {Return pressed}
IF endprogram = TRUE THEN
BEGIN
finish := clearall;
quit;
END
ELSE IF endprogram = FALSE THEN
BEGIN
finish := clearall;
restorescreen(1);
menu_loop;
END;
END; {if}
147 : BEGIN {Return to startup screen}
finish := clearall;
END;
173 : BEGIN {Exit Pgm}
reset_startup_mode;
endprogram := TRUE;
finish := clearall;
HALT;
END;
312 : BEGIN {Ruler Color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
rulerfcolor := forecolor;
rulerbcolor := backcolor;
forecolor := startforecolor;
backcolor := startbackcolor;
finish := refreshmenu;
paint_screen;
show_nest(mainmenu);
END;
801 : BEGIN {screen colors}
finish := dontclear;
color(forecolorsel, backcolorsel, forecolor, backcolor);
foreground := forecolor;
background := backcolor;
textbackground(backcolor);
clrscr;
paint_screen;
finish := dontclear;
show_nest(mainmenu);
END;
802 : BEGIN {Nest Menu Box}
color(forecolorsel, backcolorsel, forecolor, backcolor);
nttt.norfcol := forecolor;
nttt.baccol := backcolor;
nttt.boxfcol := forecolor;
nttt.boxbcol := backcolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
803 : BEGIN {Nest 1st Cap colors}
color(forecolorsel, backcolorsel, forecolor, backcolor);
nttt.capfcol := forecolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
804 : BEGIN {Nest Normal Menu Color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
nttt.norfcol := forecolor;
nttt.baccol := backcolor;
nttt.boxfcol := forecolor;
nttt.boxbcol := backcolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
805 : BEGIN {Nest Selected Topics Color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
nttt.hifcol := forecolor;
nttt.hibcol := backcolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
806 : BEGIN {Nest Non-selected Topics Color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
nttt.lofcol := forecolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
807 : BEGIN {Display a calendar}
false_calendar;
finish := dontclear;
show_nest(mainmenu);
END;
902 : BEGIN {DIRTTT Box Fore and Backround Color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
dttt.boxfcol := forecolor;
dttt.boxbcol := backcolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
903 : BEGIN {DIRTTT Special Key Foreground Color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
dttt.keyfcol := forecolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
904 : BEGIN {DIRTTT Main Background Color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
dttt.baccol := forecolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
905 : BEGIN {DIRTTT Normal File Color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
dttt.norfcol := forecolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
906 : BEGIN {DIRTTT Foreground DIR files}
color(forecolorsel, backcolorsel, forecolor, backcolor);
dttt.dirfcol := forecolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
907 : BEGIN {DIRTTT Selected file color}
color(forecolorsel, backcolorsel, forecolor, backcolor);
dttt.hifcol := forecolor;
dttt.hibcol := backcolor;
forecolor := startforecolor;
backcolor := startbackcolor;
mkwin(1, 1, 80, 25, white, black, 0);
rmwin;
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
999 : BEGIN {Exit Program}
endprogram := TRUE;
finish := clearall;
quit;
END;
1000 : BEGIN {Display Directory Manager}
dirf := display_directory(mask, r);
finish := dontclear;
END;
1500 : BEGIN {Calculator}
IF moused THEN cttt.delaytime := 100;
IF NOT moused THEN cttt.delaytime := 0;
cttt.points := 2;
calculator;
assign_idle_hook(dummy);
paint_screen;
finish := refreshmenu;
show_nest(mainmenu);
END;
END;
END;
{$F-}
PROCEDURE credit;
BEGIN
mkwin(10, 6, 50, 21, white, red, 2);
writebetween(11, 49, 8, white, red, 'FFSPAS Units');
writebetween(11, 49, 9, white, red, 'To toggle screen or menu colors');
writebetween(11, 49, 10, white, red, 'and to provide calculator support.');
writebetween(11, 49, 12, white, red, 'William W. Miller, Jr.');
writebetween(11, 49, 13, white, red, 'Brian Dunworth');
writebetween(11, 49, 14, white, red, 'The Final Frontier - A Pascal BBS');
writebetween(11, 49, 15, white, red, 'Glens Falls, N.Y. (518) 761-0869');
writebetween(11, 49, 17, white, red, 'Program review provided by');
writebetween(11, 49, 18, white, red, 'George Butts of the BufferBoard');
writebetween(11, 49, 19, white, red, 'BBS Oregon (503) 747-7636');
ch := getkey;
rmwin;
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ MAIN PROGRAM }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
BEGIN
IF numon THEN set_num(FALSE);
forecolor := 15;
backcolor := 0;
foreground := 15;
background := 0;
startforecolor := 15;
startbackcolor := 0;
rulerfcolor := 15;
rulerbcolor := 4;
cleartext(1, 1, 80, 25, forecolor, backcolor);
textattr := white;
setup_menus;
define_mainmenu;
define_filemenu;
define_windowmenu;
define_blockmenu;
define_searchmenu;
define_editmenu;
define_optionsmenu;
define_printmenu;
define_macromenu;
define_colormenu;
define_nestcolor;
define_dircolor;
define_filemgrmenu;
assign_despatcher(action);
WITH nttt DO
BEGIN
x := 0;
y := 4;
allowesc := FALSE;
leftside := FALSE;
boxfcol := black;
boxbcol := lightgray;
boxtype := 1;
capfcol := white;
baccol := lightgray;
norfcol := black;
lofcol := black;
hifcol := lightgray;
hibcol := blue;
leftchar := ' ';
rightchar := ' ';
mask := '*.*';
hook := menu_hook;
END;
WITH dttt DO
BEGIN
topx := 0;
topy := 3;
rows := 11;
zoomline := 23;
boxtype := 2;
END;
findcursor(x, y, scantop, scanbot);
offcursor;
create_tables(10);
set_default_rules(erasedefault + jumpiffull);
paint_screen;
credit;
menu_loop;
quit;
END.